home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1157 / source / componen / debugbox.pas next >
Encoding:
Pascal/Delphi Source File  |  1996-11-07  |  4.5 KB  |  185 lines
  1. unit DebugBox;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls;
  8.  
  9. type
  10.   TPositions = (poTopLeft,poBottomLeft,poTopRight,poBottomRight);
  11.  
  12.   TDebugBox = class(TComponent)
  13.   private
  14.     DebugForm : TForm;
  15.     DebugList : TListBox;
  16.     FPosition : TPositions;
  17.     FVisible  : Boolean;
  18.     FActive   : Boolean;
  19.     FWidth    : Integer;
  20.     FHeight   : Integer;
  21.     FCaption  : String;
  22.     FLogFile  : string;
  23.     procedure SetPosition(A: TPositions);
  24.     procedure SetVisible(A: Boolean);
  25.  
  26.     procedure SetWidth(A: Integer);
  27.     procedure SetHeight(A: Integer);
  28.     procedure SetCaption(A: String);
  29.   protected
  30.     { Protected declarations }
  31.     procedure Loaded; override;
  32.   public
  33.     constructor Create(AOwner: TComponent); override;
  34.     procedure Add(A: String);
  35.     procedure Clear;
  36.   published
  37.     property Caption: String read FCaption write SetCaption;
  38.     property Position: TPositions read FPosition write SetPosition default poTopRight;
  39.     property Visible: Boolean read FVisible write SetVisible;
  40.     property Active : Boolean read FActive write FActive;
  41.     property Width: Integer read FWidth write SetWidth default 250;
  42.     property Height: Integer read FHeight write SetHeight default 200;
  43.     Property LogFile : string Read FLogFile Write FLogFile;
  44.   end;
  45.  
  46. procedure Register;
  47.  
  48. implementation
  49.  
  50. procedure Register;
  51. begin
  52.   RegisterComponents('Dialogs', [TDebugBox]);
  53. end;
  54.  
  55. constructor TDebugBox.Create(AOwner: TComponent);
  56. begin
  57.   inherited Create(AOwner);
  58.   FPosition := poTopRight;
  59.   FVisible := True;
  60.   FActive  := True;
  61.   FCaption := 'Debug Box';
  62.   FWidth := 250;
  63.   FHeight := 200;
  64.   if not (csDesigning in ComponentState) then
  65.     begin
  66.       DebugForm := TForm.Create(Application);
  67.       with DebugForm do
  68.         begin
  69.           FormStyle := fsStayOnTop;
  70.           BorderStyle := bsSizeable;
  71.           BorderIcons := [biSystemMenu];
  72.         end;
  73.       DebugList := TListBox.Create(DebugForm);
  74.       with DebugList do
  75.         begin
  76.           Parent := DebugForm;
  77.           Align := alClient;
  78.           Sorted := False;
  79.           Font.Name := 'Small Fonts';
  80.           Font.Size := 7;
  81.         end;
  82.     end;
  83. end;
  84.  
  85. procedure TDebugBox.Loaded;
  86. var F:TextFile;
  87. begin
  88.   inherited Loaded;
  89.       if Active then
  90.       begin
  91.           if (length(LogFile)>0) then
  92.           begin
  93.             AssignFile(F, LogFile);
  94.             Rewrite(F);
  95.             WriteLn(F,'DebugBox Logfile: '+DateToStr(date)+' - '+TimeToStr(time));
  96.             CloseFile(F);
  97.           end;
  98.       end;
  99. end;
  100.  
  101. procedure TDebugBox.SetPosition(A: TPositions);
  102. begin
  103.   FPosition := A;
  104.   if not (csDesigning in ComponentState) then with DebugForm do
  105.     case A of
  106.       poTopLeft     : SetBounds(0,0,Width,Height);
  107.       poBottomLeft  : SetBounds(0,Screen.Height-Height,Width,Height);
  108.       poTopRight    : SetBounds(Screen.Width-Width,0,Width,Height);
  109.       poBottomRight : SetBounds(Screen.Width-Width,Screen.Height-Height,Width,Height);
  110.     end;
  111. end;
  112.  
  113. procedure TDebugBox.SetVisible(A: Boolean);
  114. begin
  115.   FVisible := A;
  116.   if not (csDesigning in ComponentState) then
  117.     begin
  118.       DebugForm.Hide;
  119.       if A then
  120.         begin
  121.           Width := Self.Width;
  122.           Height := Self.Height;
  123.           SetPosition(FPosition);
  124.           DebugForm.Show;
  125.         end;
  126.     end;
  127. end;
  128.  
  129. procedure TDebugBox.SetWidth(A: Integer);
  130. begin
  131.   FWidth := A;
  132.   if not (csDesigning in ComponentState) then
  133.     begin
  134.       DebugForm.Width := FWidth;
  135.       SetPosition(FPosition);
  136.     end;
  137. end;
  138.  
  139. procedure TDebugBox.SetHeight(A: Integer);
  140. begin
  141.   FHeight := A;
  142.   if not (csDesigning in ComponentState) then
  143.     begin
  144.       DebugForm.Height := FHeight;
  145.       SetPosition(FPosition);
  146.     end;
  147. end;
  148.  
  149. procedure TDebugBox.SetCaption(A: String);
  150. begin
  151.   FCaption := A;
  152.   if not (csDesigning in ComponentState) then
  153.     DebugForm.Caption := FCaption;
  154. end;
  155.  
  156. procedure TDebugBox.Add(A: String);
  157. var F:TextFile;
  158. begin
  159.   if Active then
  160.   begin
  161.     if (length(LogFile)>0) then
  162.     begin
  163.         AssignFile(F, LogFile);
  164.         Append(F);
  165.         WriteLn(F,A);
  166.         CloseFile(F);
  167.     end;
  168.     DebugList.Items.Add(A);
  169.     {This makes sure the item just added is visible}
  170.     DebugList.ItemIndex := DebugList.Items.Count-1;
  171.   end;
  172. end;
  173.  
  174. procedure TDebugBox.Clear;
  175. begin
  176.   if Active then
  177.   begin
  178.     {Remove all items from the list box}
  179.     DebugList.Items.Clear;
  180.   end;
  181. end;
  182.  
  183.  
  184. end.
  185.